home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / qbware.exe / BARMENU1.BAS < prev    next >
BASIC Source File  |  1990-11-30  |  3KB  |  152 lines
  1. '*****************************************************************************
  2. '
  3. '   BarMenu1.Bas
  4. '
  5. '*****************************************************************************
  6.  
  7. 'Copyright (c) 1988 Marcel Madonna
  8.  
  9. 'BARMENU1.BAS shows the use of a simple bar menu
  10. '  with QBWARE.
  11. '*****************************************************************************
  12.  
  13.  
  14.     OPTION BASE 1
  15.  
  16.  
  17. ' Dim arrays for QB Syntax check only - we REDIM them later
  18.  
  19.  
  20.     x% = 1
  21.     DIM Text$(x%), MenuText$(x%), Location%(x%, 2), TColors%(x%, 2), TLength%(x%)
  22.     DIM TblData$(x%), TblSlct%(x%), SText$(x%)
  23.  
  24.  
  25. ' Set up housekeeping for window drivers
  26.  
  27.     Snow% = 1                       'Assume you will see no flicker
  28.                     'Change this value to 0 if the screen
  29.                     'flickers
  30.  
  31.     StackSize% = 20000
  32.     DIM WinStack%(StackSize%)       'Window stack - we keep screen images
  33.                     'and other info here
  34.     DIM WinFrame%(20, 5)            'Define maximum number of windows as 20
  35.                     'we keep specific window data here
  36.     GOSUB A1000.Window.Hskp
  37.  
  38.  
  39.     RESTORE BarMenu.Txt             'Menu items
  40.     GOSUB A0600.BarMenu1            'Go display menu for the 1st time
  41.  
  42.     ON Answer% GOSUB Item1, Item2, Item3, Item4, Item5, Item6
  43.  
  44.  
  45.     GOSUB A1020.PopWindow           'Restore the window used by the menu
  46.     CLS
  47.     PRINT "You have exited without making a selection"
  48.     END
  49.  
  50. Item1:
  51. Item2:
  52. Item3:
  53. Item4:
  54. Item5:
  55. Item6:
  56.  
  57.     GOSUB A1020.PopWindow           'Restore the window used by the menu
  58.     CLS
  59.     PRINT "You have selected item" + STR$(Answer%)
  60.     END
  61.  
  62.  
  63.  
  64. A0511.LoadText:
  65.  
  66.     READ Count%
  67.     REDIM MenuText$(Count%)
  68.     x% = 1
  69.     READ MenuText$(1)
  70.     WHILE MenuText$(x%) <> "EOM" AND x% <= Count%
  71.         x% = x% + 1
  72.         READ MenuText$(x%)
  73.     WEND
  74.     MenuText$(x%) = ""
  75.     RETURN
  76.  
  77.  
  78.  
  79. A0600.BarMenu1:
  80.  
  81.     GOSUB A0511.LoadText            'Get menu items into array
  82.  
  83. ' Determine the widest menu item so we can size the window
  84.  
  85.     LineWidth% = 0
  86.     Height% = 0
  87.     FOR x% = 1 TO UBOUND(MenuText$)
  88.         IF LEN(MenuText$(x%)) > 0 THEN
  89.             Height% = Height% + 1
  90.             IF LEN(MenuText$(x%)) > LineWidth% THEN
  91.                 LineWidth% = LEN(MenuText$(x%))
  92.             END IF
  93.         END IF
  94.     NEXT
  95.  
  96. ' Use Handle 14 and put the window on the screen
  97.     WinHandle% = 14
  98.     Tr% = 5: Lc% = 6: Br% = Tr% + Height% - 1: Rc% = Lc% + LineWidth% + 1
  99.     Fg% = 0: Bg% = 3: Frame% = 2: Shade% = 1
  100.     GOSUB A1010.Prep.Window
  101.  
  102. A0601.BarMenu1:
  103.     CALL BarMenu1(WinHandle%, WinStack%(), WinFrame%(), WinPoint%, MenuText$(), Answer%)
  104.     RETURN
  105.  
  106. A1000.Window.Hskp:
  107.  
  108.     Text$ = STRING$(2000, CHR$(176))
  109.     Row% = 1: Col% = 1: Fg% = 0: Bg% = 1
  110.     CALL Putline(Snow%, Text$, Row%, Col%, Fg%, Bg%)
  111.     Text$ = ""
  112.  
  113.     MFg% = 15: MBg% = 0
  114.     MaxWin% = 20
  115.     ExitKeys$ = CHR$(27)
  116.     TabLen% = 8
  117.     SBar% = 1: SRow% = 25: SFg% = 15: Sbg% = 1
  118.  
  119.     CALL InitWin(WinStack%(), WinFrame%(), WinPoint%, MaxWin%, ExitKeys$, TabLen%, SBar%, SRow%, SFg%, Sbg%, Snow%)
  120.     RETURN
  121.  
  122.  
  123. A1010.Prep.Window:
  124.  
  125.     CALL CngWin(WinHandle%, WinStack%(), Tr%, Lc%, Br%, Rc%, Frame%, Fg%, Bg%, Grow%, Shade%)
  126.  
  127.     CALL PushWin(WinHandle%, WinStack%(), WinFrame%(), WinPoint%)
  128.     CALL Putwind(WinHandle%, WinStack%(), Head$)
  129.     RETURN
  130.  
  131. A1020.PopWindow:
  132.  
  133.     CALL PopWin(WinStack%(), WinFrame%(), WinPoint%)
  134.     RETURN
  135.  
  136.  
  137. ' These are the menu choices.
  138.  
  139. BarMenu.Txt:
  140.     DATA 7
  141.     DATA "A - this is item 1"
  142.     DATA "B - this is item 2"
  143.     DATA "C - this is item 3"
  144.     DATA "D - this is item 4"
  145.     DATA "E - this is item 5"
  146.     DATA "F - this is item 6"
  147.     DATA "EOM"
  148.  
  149.     END
  150.                               
  151.  
  152.